perm filename FNDTRN.FRI[NEW,LCS] blob sn#314569 filedate 1977-10-28 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE MNMX(IDIF,JRN)
C00017 ENDMK
CāŠ—;
	SUBROUTINE MNMX(IDIF,JRN)
	DIMENSION JRN(1)
	COMMON /MNX/MIN,MAX,JT 
 	L=MIN
 	N=MAX
	CALL MINMAX(JRN)
	J=MAX-MIN
	IF(J.LE.IDIF)GO TO 1
	MIN=L
	MAX=N
	RETURN
1	IDIF=J
	END

	SUBROUTINE FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
	DIMENSION PGTRN(1),JBAR(1),IBAR(1)
	COMMON /BRJ/JTOT,TURN,NB,DSK /STF/RSTFAC(0/7),RSTJ2
	TYPE 20
	ACCEPT 21,TURN
20	FORMAT(' TYPE TURN TIME UNIT  '$)
21	FORMAT(F)
	PGTRN(KT)=100
C LAST BAR ALWAYS GOOD FOR TURN (FOR AUTOMATIC SYSTEM)
	IBAR(1)=0
	IF(TURN.EQ.0)TURN=2
C WANTS HALF  REST FOR TURN AT FIRST
	RPG=JTOT/250.+.5
	LPG=RPG
	JP=RPG/(10.*RSTJ2)+.5
C JP= HOW MANY PAGES
	P=LPG/JP
	LT=1
11	AV=JTOT/RPG
	AV2=2*AV
	NTOT=JTOT
	KB=1
	NAV=P*AV/2.
C  FOR MINIMUM LINES PER PAGE
	MM=1
	SPG=RPG
7	JAV=AV*P 
	J=0
	DO 1 K=LT,KT
	J=J+JBAR(K)
1	IF(J.GE.JAV)GO TO 2
C JUMP OUT WHEN JPAGE IS IDEALLY FULL
2	L=-1
C  FOR FLIPFLOP
	N=K
	M=K
	NN=J
	JJ=J
3	IF(PGTRN(K).GE.TURN)GO TO 4
C JUMP IF TURN FOUND
	IF(J.GE.NAV)GO TO 10
CHECK TO SEE IF TOO SMALL A PAGE
	TURN=TURN-.5
CUT DOWN REST SIZE AND TRY AGAIN.
	GO TO 11
10	L=-L
C FLIPFLOP
	IF(L)GO TO 5
C NEXT BACKS UP
	N=N-1
	NN=NN-JBAR(N)
	J=NN
	K=N
	GO TO 3
5	M=M+1
C MOVES AHEAD TO FIND RESTS
	JJ=JJ+JBAR(M)
	J=JJ
	K=M
	GO TO 3
4	KB=KB+1
	IBAR(KB)=K
	KB=KB+1
	IBAR(KB)=100*MM
	MM=2
C  FIRST PAGE IS A SINGLE, DOUBLES AFTERWARD
	NTOT=NTOT-J
CUT DOWN TOTAL SIZE TO LOOK AT
	IF(NTOT.LE.250)GO TO 9
C  250 IS JLINE(IDEAL SIZE OF A LINE)
	RPG=NTOT/250.+.5
	LPG=RPG
	AV=(NTOT/LPG)*2.
	JP=RPG/(10.*RSTJ2)+.5
C JP= HOW MANY PAGES
	P=LPG/JP
	LT=K+1
	GO TO 7
9	IBAR(1)=P
C JP IS NUM OF LINES/PAGE FOR NOW
	KB=KB+1
	TYPE 12,TURN
12	FORMAT(' TURN TIME UNIT =',F4.2)
	END

	SUBROUTINE BRJUGL(JBAR,KT,NBAR,MBAR,JRN,PGTRN,JTRN)
	COMMON /BRJ/JTOT,TRN,NB,DSK /MNX/MIN,MAX,JT /Q/Q(1)
	COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,NO1,LPG,MPG,CLEF,SIG,NO2,SPG,MTR1,MTR2 
	DIMENSION JBAR(1),NBAR(1),MBAR(1),JRN(1),PGTRN(1),JTRN(1)
	NT=JT
	L=0
	KTOT=JTOT
	KAV=JTOT/JT

	LMIN=-1
	LMAX=10000
	LJ=0
	NJ=0
	LMM=-1
	LDIF=10000
	NBAR(1)=1
	J=1
3	M=1
	JAV=KTOT/NT
	K=JBAR(J)
1	J=J+1
	IF(J.GT.KT)GO TO 2
	N=JBAR(J)
	IF(K+N/2.GE.JAV)GO TO 2
	M=M+1
	K=K+N
	GO TO 1
2	L=L+1
	KTOT=KTOT-K
	NT=NT-1
	JRN(L)=K
	NBAR(L+1)=J
	IF(NT.GT.0)GO TO 3
5	MAX=0
	MIN=10000

	DO 7 L=1,JT
	K=JRN(L)
	IF(K.LE.MAX)GO TO 6
	MAX=K
	MX=L
6	IF(K.GE.MIN)GO TO 7
	MIN=K
	MN=L
7	CONTINUE

	J=MAX-MIN
	IF(MAX.GE.LMAX.AND.J.GE.LDIF)GO TO 9
	IF(MIN.GT.LMIN)LMIN=MIN
	IF(MAX.LT.LMAX)LMAX=MAX
	IF(J.LT.LDIF)LDIF=J
	CALL RLOOP(MBAR(2),NBAR(2),JT)
C  SAVE NBAR INFO IN MBAR

	IF(MX.LT.MN)GO TO 32
	IF(MX.LE.1)GO TO 5
	JJ=0
	JM=-1
	JK=1
23	K=NBAR(MX+JJ)-JJ
C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
	MM=JBAR(K)
	JRN(MX)=JRN(MX)-MM
	JMX=JM+MX
	JRN(JMX)=JRN(JMX)+MM
	NBAR(MX+JJ)=K+JK
	MX=JMX
	IF(JJ.NE.0)GO TO 223
	IF(MX.GT.MN)GO TO 23
	GO TO 5 
223	IF(MX.LT.MN)GO TO 23
	GO TO 5 
32	JJ=1
	JM=1
	JK=0
	GO TO 23
9	CALL GET(NBAR,JBAR,MBAR,JRN)
CC9	CALL GET
	IDIF=10000
	JJT=JT-1
104	CALL MNMX(IDIF,JRN)
108	DO 102 J=1,JJT
	IF(JRN(J).LE.KAV)GO TO  102
C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
	I=NBAR(J+1)-1
	IF(I.EQ.NBAR(J))GO TO 102
C WE'RE DOWN TO ONE BAR
	JJ=JRN(J)-JBAR(I)
C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
	IF(JJ.LT.MIN)GO TO 102
	KK=JRN(J+1)+JBAR(I)
	IF(KK.GT.MAX)GO TO 103
C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
	CALL MINMAX(JRN)
105	JRN(J)=JJ
	JRN(J+1)=KK
	NBAR(J+1)=NBAR(J+1)-1
	GO TO 104
103	IF(J.EQ.JJT)GO TO 102
	NN=KK
	DO 106 K=J+1,JJT
	LL=NBAR(K+1)-1
C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
	MM=NN-JBAR(LL)
	IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 102
	NN=JBAR(LL)+JRN(K+1)
106	IF(NN.LE.MAX)GO TO 105
102	CONTINUE
204	CALL MNMX(IDIF,JRN)
208	DO 202 J=JT,2,-1
	IF(JRN(J).LE.KAV)GO TO  202
C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
	I=NBAR(J)
	IF(I-1.EQ.NBAR(J-1))GO TO 202
C WE'RE DOWN TO ONE BAR
	JJ=JRN(J)-JBAR(I)
C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
	IF(JJ.LT.MIN)GO TO 202
	KK=JRN(J-1)+JBAR(I)
	IF(KK.GT.MAX)GO TO 203
C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
	CALL MINMAX(JRN)
205	JRN(J)=JJ
	JRN(J-1)=KK
	NBAR(J)=NBAR(J)+1
	GO TO 204
203	IF(J.EQ.2)GO TO 202
	NN=KK
	DO 206 K=J-1,2,-1
	LL=NBAR(K)
C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
	MM=NN-JBAR(LL)
	IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 202
	NN=JBAR(LL)+JRN(K-1)
206	IF(NN.LE.MAX)GO TO 205
202	CONTINUE

	CALL MINMAX(JRN)
	IDIF=MAX-MIN
	CALL RLOOP(MBAR(2),NBAR(2),JT)
400	MX=MAX+5
	JR=1
C  JR = HOW MANY BARS TO RIPPLE
	I=MAX-MIN
	IF(I.GT.IDIF)GO TO 402
	CALL RLOOP(MBAR(2),NBAR(2),JT)
	IDIF=I
402	DO 401 J=1,JT
401	IF(JRN(J).EQ.MIN)GO TO 408
C  TRY RIPPLE EACH WAY FROM SMALLEST VALUE
408	IF(J.EQ.JT)GO TO 508
C RIPPLE FORWARD FIRST
	I=NBAR(J+1)
	JJ=JRN(J)+JBAR(I)
	IF(JJ.GT.MX)GO TO 508
C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
	NN=JRN(J+1)-JBAR(I)
	IF(NN.LT.MIN)GO TO 404
C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
	JRN(J)=JJ
	JRN(J+1)=NN
	NBAR(J+1)=I+1
415	CALL MINMAX(JRN)
C NOW GO BACK AND TRY AGAIN.
	GO TO 400

405	JRN(J)=JJ

	DO 422 IB=J+1,N
	LB=NBAR(IB)
	JB=JRN(IB)-JBAR(LB)
	NBAR(IB)=LB+1
	IF(JB.LT.MIN)GO TO 421
	JRN(IB)=JB
	GO TO 415

421	IBB=IB+1
	LC=NBAR(IBB)
	JB=JB+JBAR(LC)
	IF(JB.GT.MIN)GO TO 422
C NOW ADD A SECOND BAR
	JRN(IBB)=JRN(IBB)-JBAR(LC)
	LC=LC+1
	JB=JB+JBAR(LC)
	NBAR(IBB)=LC

422	JRN(IB)=JB
	NBAR(IBB)=LC+1
	JRN(IBB)=JRN(IBB)-JBAR(LC)
	GO TO 415
C NOW GO BACK AND TRY AGAIN.
	
404	IF(J.EQ.JJT)GO TO 508
	DO 406 N=J+1,JJT
  	LL=NBAR(N+1)
	MM=NN+JBAR(LL)
	IF(MM.GT.MX)GO TO 508
	IF(MM.GT.MIN)GO TO 409
C NEXT TO RIPPLE 2 BARS!
412	MN=MM+JBAR(LL+1)
C  ADD ON A SECOND BAR
	IF(MN.GT.MX)GO TO 508
C DON'T WORRY ABOUT IT BEING TOO SMALL (YET)
	NN=JRN(N+1)-JBAR(LL)-JBAR(LL+1)
	IF(NN.GT.MIN)GO TO 405
	GO TO 406

409	NN=JRN(N+1)-JBAR(LL)
	IF(NN.GE.MIN)GO TO 405
406	CONTINUE

C  TRY RIPPLE EACH WAY FROM SMALLEST VALUE
508	IF(J.EQ.1)GO TO 502
	IF(J.EQ.LJ.AND.MX-MN.EQ.LMM)GO TO 502
	IF(JDIF.EQ.IDIF)GO TO 150
	ICNT=0
	GO TO 151
150	ICNT=ICNT+1
	IF(ICNT.EQ.10)GO TO 515
151	JDIF=IDIF
C THIS SHOULD AVOID GETTING INTO A LOOP
	LJ=J
	LMM=MX-MN
C RIPPLE BACK NOW
	I=NBAR(J)-1
	JJ=JRN(J)+JBAR(I)
	IF(JJ.GT.MX)GO TO 502
C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
	NN=JRN(J-1)-JBAR(I)
	IF(NN.LT.MIN)GO TO 504
C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
	JRN(J)=JJ
	JRN(J-1)=NN
	NBAR(J)=I
	GO TO 415
505	JRN(J)=JJ
	DO 522 IB=J-1,N,-1
	LB=NBAR(IB+1)-1
	JB=JRN(IB)-JBAR(LB)
	NBAR(IB+1)=LB
	IF(JB.LT.MIN)GO TO 521
	JRN(IB)=JB
	GO TO 415
521	IBB=IB-1
	LC=NBAR(IB)-1
	JB=JB+JBAR(LC)
	IF(JB.GT.MIN)GO TO 522
	JB=JB+JBAR(LC-1)
	NBAR(IB)=LC
	JRN(IBB)=JRN(IBB)-JBAR(LC)
CHECK THIS OUT!!
	LC=LC-1
522	JRN(IB)=JB
	JRN(IBB)=JRN(IBB)-JBAR(LC)
	NBAR(IB)=LC
	GO TO 415
504	IF(J.LE.2)GO TO 502
	DO 506 N=J-1,2,-1
 	LL=NBAR(N)-1
	MM=NN+JBAR(LL)
	IF(MM.GT.MX)GO TO 502
	IF(MM.GT.MIN)GO TO 509
512	MN=MM+JBAR(LL-1)
	IF(MN.GT.MX)GO TO 502
	NN=JRN(N-1)-JBAR(LL)-JBAR(LL-1)
	IF(NN.GT.MIN)GO TO 505
	GO TO 506
509	NN=JRN(N-1)-JBAR(LL)
	IF(NN.GE.MIN)GO TO 505
506	CONTINUE
502	IF(J.EQ.NJ.AND.MX-MN.EQ.LMM)GO TO 515
C  CHECK TO AVOID ENDLESS LOOP.
	NJ=J
	IF(J.EQ.JT)GO TO 515
C LOOK FOR OTHER LINES = MIN.
	DO 510 K=J+1,JT
	IF(JRN(K).NE.MIN)GO TO 510
	J=K
	GO TO 408
510	CONTINUE

515	CALL GET(NBAR,JBAR,MBAR,JRN)
CC515	CALL GET

13	DO 14 L=2,JT
	K=NBAR(L)
	MM=JRN(L)
	KK=JRN(L-1)
	IF(MM.GE.KK)GO TO 12
C  JUGGLES ADJACENT LINES
	N=JBAR(K-1)
	IF(KK-MM.LT.N)GO TO 14
	JRN(L-1)=KK-N
	JRN(L)=MM+N
	NBAR(L)=K-1
	GO TO 13
12	N=JBAR(K)
	IF(MM-KK.LE.N)GO TO 14
	JRN(L-1)=KK+N
	JRN(L)=MM-N
	NBAR(L)=K+1
	GO TO 13
14	CONTINUE
46	J=1
	NBAR(JT+1)=KT+1
	JAV=JTOT/JT
	CALL MINMAX(JRN)
308	FORMAT(' AVG=',I3,'  MIN=',I3,'  MAX=',I3)
	TYPE 308,JAV,MIN,MAX
	IF(DSK)WRITE(21,308)JAV,MIN,MAX
307	DO 310 K=1,NBAR(JT+1)-1
	L=JBAR(K)
	IF(PGTRN(K).GE.TRN)L=-L
310	JTRN(K)=L
C ABOVE MAKES NEG. BAR VALUES WHERE TURNS ARE POSSIBLE.
	
	LJ=0
306	FORMAT(I5,'  (',I3,')',3X50I5)
309	DO 305 K=1,JT
	LJ=LJ+1
	NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
	L=NBAR(K)-1+J
	MM=NB+J-1
	TYPE 306,JRN(K),MM,(JTRN(N),N=J,L)
	IF(DSK)WRITE(21,306)JRN(K),MM,(JTRN(N),N=J,L)
	IF(LJ.LT.MPG)GO TO 305
	LJ=0
	IF(DSK)WRITE(21,3066)
	TYPE 3066
3066	FORMAT(' ************')
305	J=L+1
	NBAR(JT+1)=0
	END

	SUBROUTINE GET(NBAR,JBAR,MBAR,JRN)
	COMMON  /MNX/MIN,MAX,JT
	DIMENSION MBAR(1),JBAR(1),JRN(1),NBAR(1)
	J=1
	DO 1 K=2,JT+1
	NBAR(K)=MBAR(K)
	N=0
	DO 2 L=J,MBAR(K)-1
C FIX UP JRN ARRAY
2	N=N+JBAR(L)
	JRN(K-1)=N
1	J=MBAR(K)
	END

CC	SUBROUTINE MNMX(IDIF,JRN)
CC	COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
CC	L=MIN
CC	N=MAX
CC	CALL MINMAX(JRN)
CC	J=MAX-MIN
CC	IF(J.LE.IDIF)GO TO 1
CC	MIN=L
CC	MAX=N
CC	RETURN
CC1	IDIF=J
CC	END
***** Arrow at Line 12 of 543 ***** Page 2 of 2 ***** 18R +366C *****